# $Id: StatsDouble.pm,v 1.1 2004/04/27 14:26:22 ibo Exp $

package CGI::FOGE2::StatsDouble;
use strict;
use CGI::FOGE2::Tools;
our @ISA = qw(CGI::FOGE2::Stats);

sub new {
    my $proto = shift;
    my %params = @_;
    my $class = ref($proto) || $proto;

    my @mandatory_keys = ();
    my $self  =
	{
        #TODO: this code should be inherited rather than copied        FUTURE
        answer     => theform->{dbAnswer},
        enquiry    => theform->{enquiry},
        relation   => undef,
        columns    => undef,
        question   => undef,
        types      => [],
        caption    => undef,

	relation_2 => undef,
	columns_2  => undef,
	question_2 => $params{q2},
	};

    bless ($self, $class);
    my $q2 = $params{q2};
    $self->setrelation_2($q2->{section}->{table});
    $self->setquestion_2($q2);
    $self->setcolumns_2($q2->generate_field_names());
    
    return $self;
}

sub setrelation_2 {
    my $self = shift;
    my ($relation_2) = @_;
    $self->{relation_2} = $relation_2;
}

sub setcolumns_2 {
    my $self = shift;
    my ($columns_2) = @_;
    $self->{columns_2} = $columns_2;
}

sub setquestion_2 {
    my $self = shift;
    my ($question_2) = @_;
    $self->{question_2} = $question_2;
}

sub getstats {
    my $self = shift;
    my %histogram = %{$self->computeDouble()};

    return 'deuxieme caractere manque' unless
	defined $self->{question_2};

    my $out = '';

    print STDERR "HISTOGRAMA: ", keys(%histogram);

    $out .= CGI::Tr(CGI::td('&nbsp;') . CGI::td([keys %{$histogram{each %histogram}}]));

    # Only to reset the 'each' operator
    scalar(keys %histogram);

    foreach my $i (keys %histogram) {
	my $tr = CGI::td($i);
	foreach my $j (keys %{$histogram{$i}}) {
	    $tr .= CGI::td($histogram{$i}{$j});
	}
	$out .= CGI::Tr($tr);
    }

    $out = CGI::table({-border => '1'}, $out);


    my $x_label = $self->{columns}[0];
    my $y_label = $self->{columns_2}[0];
    my $title = "Stat croisees";
    my @labels = keys %{$histogram{each %histogram}};
    my @legend = keys %histogram;
    my $n = 6; #$#labels;

    my $params = 
	'x_label=' . $x_label .
	'&y_label=' . $y_label .
	'&title=' . $title .
	'&n=' . $n .
	'&' . (join '&', map "labels=$_", @labels) . 
	'&' . (join '&', map "legend=$_", @legend);


    my $cpt = 0;
    foreach my $h (values %histogram) {
	my @vals = values %$h;
	$params .= '&' . (join '&', map "vals_$cpt=$_", @vals);
	$cpt++
    }
    

    $out .= CGI::img({-src => "pics.pl?" . $params});

    return $out;
}

sub computeDouble {
    my $self = shift;
    my $dbh = theform->dbh_r();

    my $col = $self->{columns}[0];
    my $rel = $self->{relation};
    my $col_2 = $self->{columns_2}[0];
    my $rel_2 = $self->{relation_2};

    my $ans = $self->{answer};

    my $sql =
	"select count(*), rel.$col, rel_2.$col_2\n" .
	"from $ans answer, $rel rel, $rel_2 rel_2\n" .
	"where answer.id = rel.id AND rel.id = rel_2.id\n" .
	"group by rel.$col, rel_2.$col_2;\n";

    my $sth = $dbh->prepare($sql)
        || die sprintf msg->die_cantprep_query, $dbh->errstr;
    $sth->execute()
        || die sprintf msg->die_cantexec_query, $sth->errstr;


    my $q = $self->{question};
    my $q2 = $self->{question_2};
    my $items = $q->{items};
    my $items2 = $q2->{items};

    my %histogram = ();
    foreach my $i (@$items) {
	foreach my $j (@$items2) {
	    $histogram{$i}{$j} = 0;
	}
    }

    while (my $row = $sth->fetchrow_arrayref) {
	print STDERR 'ARAYAE: ', (join "  |  ", @$row), "\n";
        $histogram{$$row[1]}{$$row[2]} = $$row[0];
    }

    return \%histogram;
}

1;
